home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / umich / network / midi / mx2net20.lzh / MX2NET20 / NETWORK.MOD < prev   
Encoding:
Modula Implementation  |  1990-12-15  |  38.4 KB  |  1,178 lines
  1. (*                                                              *)
  2. (*              Copyright 1989 fred brooks LogicTek             *)
  3. (*                                                              *)
  4. (*   First Release                      12/8/87-FGB             *)
  5. (*   Added drive config data routines, clean up VBL code,       *)
  6. (*   Remote time option                 12/17/89-FGB            *)
  7. (*                                                              *)
  8.  
  9. IMPLEMENTATION MODULE NETWORK ;
  10.  
  11. (* --------------------------------------------------------------------------
  12.  
  13.                NETWORK : TWO CPU NETWORK FOR TDI Modula-2/ST
  14.  
  15.    --------------------------------------------------------------------------*)
  16.  
  17. (*$T-,$S-,$A+ *)
  18.  
  19. FROM SYSTEM IMPORT ADDRESS, ADR, SETREG, CODE, REGISTER ,BYTE ,TSIZE;
  20. FROM BIOS   IMPORT BPB ,BConStat ,BConIn, BCosStat, BConOut, Device,
  21.                    MediaChange,MCState,GetBPB,RWAbs,RW,DriveSet,DriveMap;
  22. FROM XBIOS  IMPORT SuperExec,IORec,IORECPTR,IOREC,SerialDevice,
  23.                    GetDateTime,ScreenPhysicalBase;
  24. FROM GEMDOS IMPORT TermRes,Open,Close,SetDate,SetTime ;
  25. IMPORT             GEMDOS;
  26. FROM ASCII  IMPORT SYN,STX,SOH,BEL,CR,LF,ESC;
  27.  
  28. CONST
  29.   MaxSeq          = 1;
  30.   Maxdrives       = 31; (* number of disk drives minus 1 *)
  31.   recsize         = 511;
  32.   retry           = 5;
  33.   MAGIC           = 314159;
  34.   Memdrive        = 31;
  35.   chanwait        = 3;
  36.   debug           = FALSE;
  37.   trace           = FALSE;
  38.   TITLE           = "MX2NET Version 2.0   Fred Brooks  UUCP crash!fgbrooks";
  39.  
  40.   (* Because we dont know what registers the BIOS is using we must use
  41.      the following opcodes to save the registers *)
  42.   MOVEMDEC = 48E7H ;    (* 68000 opcode for MOVEM <regs>,-(A7) *)
  43.   MOVEMINC = 4CDFH ;    (* 68000 opcode for MOVEM (A7)+,<regs> *)
  44.   SAVEREGS = 07FFCH ;   (* Registers D1..A5 for DEC *)
  45.   RESTREGS = 03FFEH ;   (* Registers D1..A5 for INC *)
  46.   RTS = 04E75H ;        (* 68000 return from subroutine opcode *)
  47.  
  48. TYPE
  49.   (* Procedure types to mimic correct sequence for "C" BIOS routines *)
  50.  
  51.   CBPBProc     = PROCEDURE ( CARDINAL ) ;
  52.   CMediaChProc = PROCEDURE ( CARDINAL ) ;
  53.   CRWAbsProc   = PROCEDURE ( CARDINAL, CARDINAL, CARDINAL, ADDRESS, CARDINAL );
  54.   MIDIbuffer   = ARRAY [0..1023] OF CARDINAL;
  55.   SequenceNr   = [0..MaxSeq];
  56.   message      = ARRAY [0..recsize] OF BYTE;
  57.   message1     = ARRAY [0..17] OF BYTE;
  58.   FrameKind    = (ack,data,callreq,callaccp,clearreq,clearconf,
  59.                  resetreq,diag);
  60.   DataKind     = (rdmediareq,rdmediaconf,rdbpbreq,rdbpbconf,
  61.                  rdrwabsreq,rdrwabsconf,memreq,memconf,timereq,timeconf);
  62.   evtype       = (framearrival,cksumerr,timeout,hostready,reset,nothing);
  63.   channel      = (none,local,remote);
  64.  
  65.   frame        = RECORD
  66.                  syn    :       CHAR; (* these are sync chars *)
  67.                  stx    :       CHAR; (* for the frames       *)
  68.                  kind   :       FrameKind;
  69.                  seq    :       SequenceNr;
  70.                  ack    :       SequenceNr;
  71.                  cmd    :       DataKind;
  72.                  rw     :       CARDINAL; (* read or write data *)
  73.                  recno  :       CARDINAL; (* sector for data*)
  74.                  d0     :       LONGCARD; (* data return variable *)
  75.                  info   :       message;
  76.                  cksum  :       CARDINAL;
  77.                END;
  78.  
  79.   framecptr    = POINTER TO framecmd;
  80.  
  81.   framecmd     = RECORD
  82.                  syn    :       CHAR; (* these are sync chars *)
  83.                  stx    :       CHAR; (* for the frames       *)
  84.                  kind   :       FrameKind;
  85.                  seq    :       SequenceNr;
  86.                  ack    :       SequenceNr;
  87.                  cmd    :       DataKind;
  88.                  rw     :       CARDINAL; (* read or write data *)
  89.                  recno  :       CARDINAL; (* sector for data*)
  90.                  d0     :       LONGCARD; (* data return variable *)
  91.                  info   :       message1;
  92.                  cksum  :       CARDINAL;
  93.                END;
  94.  
  95.   control     = RECORD
  96.                  magic          :       LONGCARD;
  97.                  reset          :       BOOLEAN;
  98.                  networkactive  :       BOOLEAN;
  99.                  remotedrive    :       CARDINAL;
  100.                  drivemap       :       DriveSet;
  101.                 nextframetosend :      SequenceNr;
  102.                 frameexpected   :      SequenceNr;
  103.                 sendreset       :      BOOLEAN;
  104.                END;
  105.  
  106.   netmap      = RECORD
  107.                  Remote         :       CARDINAL;
  108.                  Local          :       CARDINAL;
  109.                  Write          :       BOOLEAN;
  110.                 END;
  111.  
  112.   frameptr      =       POINTER TO ARRAY [0..1024] OF BYTE;
  113.  
  114. VAR
  115.  
  116.  
  117.   (* BIOS variables : These can only be accessed with the 68000 in supervisor
  118.      mode. The Modula-2 language allows you to fix the location of variables *)
  119.  
  120.   HDBPB     [0472H] : ADDRESS ;       (* hard disk get Bios Parameter Block *)
  121.   HDRWAbs   [0476H] : ADDRESS ;       (* hard disk read/write abs   *)
  122.   HDMediaCh [047EH] : ADDRESS ;       (* hard disk media change     *)
  123.   EvtCritic [0404H] : ADDRESS ;       (* evt_critic *)
  124.   DriveBits [04C2H] : SET OF [0..31]; (* disk drives present map    *)
  125.   flock     [043EH] : LONGCARD;       (* disk access in progress    *)
  126.   hz200     [04baH] : LONGCARD;       (* 200hz clock counter        *)
  127.  
  128.   NetBits           : SET OF [0..31];
  129.   Dptr              : DriveSet;       (* save original drive map    *)
  130.   Mptr              : LONGCARD;
  131.   charcount,framesize,cksum,recframesize,sndframesize,
  132.   SIZEframe,SIZEframecmd                                : CARDINAL;
  133.  
  134.   networkconnect          :   BOOLEAN; (* DCD = 1 TRUE  *)
  135.   gotframe                :   BOOLEAN;
  136.   framebufferfull         :   BOOLEAN;
  137.   cleartosend             :   BOOLEAN;
  138.   readytosend             :   BOOLEAN;
  139.   requesttosend           :   BOOLEAN;
  140.   framewaiting            :   BOOLEAN;
  141.   OK,installed            :   BOOLEAN;
  142.   gotmediach              :   ARRAY [0..Maxdrives] OF BOOLEAN;
  143.   gotbpb                  :   ARRAY [0..Maxdrives] OF BOOLEAN;
  144.   networkerror            :   BOOLEAN;
  145.   shortframe              :   BOOLEAN;
  146.   vblLock                 :   BOOLEAN;
  147.   rwabsLock               :   BOOLEAN;
  148.   TIMESET                 :   BOOLEAN;
  149.   OneTime                 :   BOOLEAN;
  150.   ChannelLock             :   channel;
  151.   NetMap                  :   ARRAY [0..Maxdrives] OF netmap;
  152.   NetInfo                 :   ARRAY [0..128] OF CHAR;
  153.   statptr                 :   POINTER TO stat;
  154.  
  155.   sframe,rframe,SFRAME,RFRAME                   :   frame;
  156.   rframeptr                                     :   frameptr;
  157.   framecmdptr                                   :   framecptr;
  158.   sframecmdptr                                  :   framecptr;
  159.   event                                         :   evtype;
  160.   C                                             :   control;
  161.   S                                             :   stat;
  162.   recchar                                       :   LONGCARD;
  163.   result,i,i1,mediacount,handle                 :   INTEGER;
  164.   D0ptr                                         :   POINTER TO LONGCARD;
  165.   wsector,drvnr,d,R                             :   CARDINAL;
  166.   rbuffer                                       :   MIDIbuffer;
  167.   rbptr,kbdiorec                                :   IORECPTR;
  168.   numBytes,sec,min,hour,time,count              :   LONGCARD ;
  169.   status                                        :   LONGINT ;
  170.   sframeptr                                     :   frameptr;
  171.  
  172.   (* The following are saved copies of the BIOS variables so that the real
  173.      hard disk routines can be called if a hard disk access is requested. *)
  174.  
  175.   SaveHDBPB      : CBPBProc ;     (* hard disk get Bios Parameter Block *)
  176.   SaveHDRWAbs    : CRWAbsProc ;   (* hard disk read/write abs *)
  177.   SaveHDMediaCh  : CMediaChProc ; (* hard disk media change *)
  178.   SaveCritic     : PROC;
  179.  
  180.   (* NETWORK control *)
  181.  
  182.   NetworkBPB  : ARRAY [0..Maxdrives] OF BPB ; (* BIOS Parameter block for NETWORK *)
  183.  
  184.  
  185. PROCEDURE inc(VAR k: SequenceNr);   (* increment k circulary *)
  186. BEGIN
  187.         IF k<MaxSeq THEN INC(k) ELSE k:=0 END;
  188. END     inc;
  189.  
  190. MODULE  NETBIOS;
  191. IMPORT  getfromremote,frameptr,ADDRESS,CODE,MOVEMDEC,SAVEREGS,status,
  192.         Memdrive,statptr,S,MOVEMINC,RESTREGS,NetBits,wsector,DataKind,
  193.         C,NetMap,resetnewdisk,channel,ADR,rwabsLock,frame,
  194.         networkerror,SETREG,SaveHDBPB,SaveHDRWAbs,SaveHDMediaCh,TSIZE,
  195.         newdisk,gotbpb,gotmediach,MCState,NetworkBPB,BPB;
  196.  
  197. EXPORT  RDRWAbs,RDMediaCh,RDBPB;
  198.  
  199. VAR     i3                              :       CARDINAL;
  200.         bpbptr,nbpbptr                  :       frameptr;
  201.         nframe1                         :       frame;
  202.  
  203. PROCEDURE MoveMemory ( From, To : ADDRESS ; Bytes : LONGCARD ) ;
  204. (* This routine shows how time critical portions of code can be optimised to
  205.    run faster. It relys on the code generation rules of the compiler which 
  206.    can be checked by dis-assembling the link file with DecLnk.*)
  207.  
  208. CONST
  209.   MOVEB = 12D8H ;       (*      MOVE.B  (A0)+,(A1)+     *)
  210.   MOVEL = 22D8H ;       (*      MOVE.L  (A0)+,(A1)+     *)
  211.   A0    = 0+8 ;         (* register A0 *)
  212.   A1    = 1+8 ;         (* register A1 *)
  213.  
  214. BEGIN
  215.   SETREG(A0,From) ;             (* load From pointer into A0 *)
  216.   SETREG(A1,To) ;               (* load To pointer into A1 *)
  217.   
  218.   IF ( ODD(From) OR ODD(To) ) THEN      (* must do bytes *)
  219.     WHILE ( Bytes <> 0 ) DO
  220.       CODE(MOVEB) ;
  221.       DEC(Bytes) ;
  222.     END ;
  223.   ELSE (* even addresses so can do long moves *)
  224.     WHILE ( Bytes > 3 ) DO
  225.       CODE(MOVEL) ;
  226.       DEC(Bytes,4) ;
  227.     END ;
  228.     WHILE ( Bytes <> 0 ) DO
  229.       CODE(MOVEB) ;             (* clean up remainder *)
  230.       DEC(Bytes) ;
  231.     END ;
  232.   END ;
  233. END MoveMemory ;
  234.  
  235. (* The following procedures mimic the disk handling routines called by the
  236.    BIOS. Their procedure declarations have been written to mimic the "C"
  237.    calling sequence. *)
  238.  
  239. PROCEDURE RDRWAbs ( device, RecordNum, SectorCount : CARDINAL ;
  240.                     Buffer : ADDRESS ; Flag : CARDINAL ) ;
  241. (* NB. It is assumed that GEMDOS wont call this routine with out of range
  242.    parameters *)
  243. CONST D0 = 0 ;
  244. BEGIN
  245.   CODE(MOVEMDEC,SAVEREGS) ;     (* save registers on stack *)
  246.   status := 0;
  247.   IF (device=Memdrive) AND (RecordNum=0) THEN (* get network stats *)
  248.     statptr:=Buffer;
  249.     statptr^:=S;
  250.     CODE(MOVEMINC,RESTREGS) ;     (* Restore registers from stack *)
  251.     RETURN;
  252.   END;
  253.   IF device IN NetBits THEN (* is NETWORK channel *)
  254.     IF ( Flag = 0 ) OR ( Flag = 2 ) (* read *)  THEN
  255.       FOR wsector:=0 TO (SectorCount-1) DO
  256.            C.remotedrive:=NetMap[device].Remote;
  257.            nframe1.d0:=LONGCARD(NetMap[device].Remote);
  258.            nframe1.recno:=RecordNum+wsector;
  259.            nframe1.rw:=Flag; (* read *)
  260.            resetnewdisk;
  261.            IF getfromremote(rdrwabsreq,rdrwabsconf,nframe1,local) THEN
  262.               MoveMemory(ADR(nframe1.info),Buffer+ADDRESS(wsector)*512,
  263.                          512);
  264.               status:=0;
  265.            ELSE
  266.               status:=(-11);
  267.            END; (* if *)
  268.        END; (* for *)
  269.     IF networkerror THEN C.sendreset:=TRUE END; (* send network reset to remote cpu *)
  270.       SETREG(D0,status) ;
  271.     ELSIF ( Flag = 1 ) OR ( Flag = 3 ) THEN (* write *)
  272.        IF NetMap[device].Write THEN
  273.          FOR wsector:=0 TO (SectorCount-1) DO
  274.            C.remotedrive:=NetMap[device].Remote;
  275.            nframe1.d0:=LONGCARD(NetMap[device].Remote);
  276.            nframe1.recno:=RecordNum+wsector;
  277.            nframe1.rw:=Flag; (* write *)
  278.            resetnewdisk;
  279.            MoveMemory(Buffer+ADDRESS(wsector)*512,ADR(nframe1.info),512);
  280.            IF getfromremote(rdrwabsreq,rdrwabsconf,nframe1,local) THEN
  281.               status:=0;
  282.            ELSE
  283.               status:=(-10);
  284.            END;
  285.          END; (* for *)
  286.     IF networkerror THEN C.sendreset:=TRUE END; (* send network reset to remote cpu *)
  287.        ELSE
  288.          status:=(-13); (* write protect *)
  289.        END;
  290.       SETREG(D0,status) ;
  291.     ELSE
  292.       SETREG(D0,LONGINT(-3)) ;
  293.     END ;
  294.   ELSE (* not NETWORK *)
  295.     rwabsLock:=TRUE;
  296.     SaveHDRWAbs (device,RecordNum,SectorCount,Buffer,Flag) ;
  297.     rwabsLock:=FALSE;
  298.   END ;
  299.   CODE(MOVEMINC,RESTREGS) ;     (* Restore registers from stack *)
  300. END RDRWAbs ;
  301.  
  302. PROCEDURE RDMediaCh ( device : CARDINAL ) ;
  303. CONST D0 = 0 ;
  304. BEGIN
  305.   CODE(MOVEMDEC,SAVEREGS) ;     (* save registers on stack *)
  306.   IF device IN NetBits THEN (* is NETWORK channel *)
  307.     C.remotedrive:=NetMap[device].Remote;
  308.     nframe1.d0:=LONGCARD(NetMap[device].Remote);
  309.     IF newdisk() THEN
  310.        gotmediach[NetMap[device].Remote]:=FALSE;
  311.        gotbpb[NetMap[device].Remote]:=FALSE;
  312.     END;
  313.     IF (NOT gotmediach[NetMap[device].Remote]) THEN
  314.      IF getfromremote(rdmediareq,rdmediaconf,nframe1,local) THEN
  315.         gotmediach[NetMap[device].Remote]:=TRUE;
  316.         IF nframe1.d0=1 THEN nframe1.d0:=2 END;
  317.         SETREG(D0,nframe1.d0) ;    (* "C" uses D0 as return location *)
  318.      ELSE
  319.         SETREG(D0,Changed);
  320.      END;
  321.     ELSE
  322.        SETREG(D0,NoChange) ;    (* "C" uses D0 as return location *)
  323.     END; 
  324.   ELSE (* not NETWORK *)
  325.     rwabsLock:=TRUE;
  326.     SaveHDMediaCh(device) ;
  327.     rwabsLock:=FALSE;
  328.   END;
  329.   CODE(MOVEMINC,RESTREGS) ;     (* Restore registers from stack *)
  330. END RDMediaCh ;
  331.  
  332. PROCEDURE RDBPB ( device : CARDINAL ) ;
  333. CONST D0 = 0 ;
  334. BEGIN
  335.   CODE(MOVEMDEC,SAVEREGS) ;     (* save registers on stack *)
  336.   IF device IN NetBits THEN (* is NETWORK channel *)
  337.     C.remotedrive:=NetMap[device].Remote;
  338.     nframe1.d0:=LONGCARD(NetMap[device].Remote);
  339.     IF newdisk() THEN
  340.       gotbpb[NetMap[device].Remote]:=FALSE;
  341.       gotmediach[NetMap[device].Remote]:=FALSE;
  342.     END;
  343.     IF (NOT gotbpb[NetMap[device].Remote]) THEN
  344.      IF getfromremote(rdbpbreq,rdbpbconf,nframe1,local) THEN
  345.        gotbpb[NetMap[device].Remote]:=TRUE;
  346.        bpbptr:=ADR(nframe1.info);
  347.        nbpbptr:=ADR(NetworkBPB[NetMap[device].Remote]);
  348.        FOR i3:=0 TO TSIZE(BPB)-1 DO
  349.            nbpbptr^[i3]:=bpbptr^[i3];    
  350.        END;
  351.        resetnewdisk;
  352.        SETREG(D0,ADR(NetworkBPB[NetMap[device].Remote])); (* D0 returns address of the BPB *)
  353.      ELSE
  354.        SETREG(D0,0);
  355.      END;
  356.     ELSE
  357.        SETREG(D0,ADR(NetworkBPB[NetMap[device].Remote])); (* D0 returns address of the BPB *)
  358.     END; 
  359.     IF networkerror THEN C.sendreset:=TRUE END; (* send network reset to remote cpu *)
  360.   ELSE (* not NETWORK *)
  361.     rwabsLock:=TRUE;
  362.     SaveHDBPB(device) ;
  363.     rwabsLock:=FALSE;
  364.   END ;
  365.   CODE(MOVEMINC,RESTREGS) ;     (* Restore registers from stack *)
  366. END RDBPB ;
  367.  
  368. BEGIN
  369. END     NETBIOS;
  370.     
  371. MODULE  TIME;
  372. IMPORT  hz200,CODE,RTS,SuperExec,SETREG,REGISTER,ChannelLock,channel,
  373.         chanwait;
  374. EXPORT  StartTimer,TimeOut,timer,resetnewdisk,newdisk,freechannel,
  375.         resetchannel;
  376.  
  377. VAR     timer                                   :       BOOLEAN;
  378.         clock                                   :       LONGCARD;
  379.         timestart,timefortimeout,timeouttime,
  380.         timestart2,timefortimeout2,timeouttime2,
  381.         timestart1,timefortimeout1,timeouttime1 :       LONGCARD;
  382. (*$P- *)
  383. PROCEDURE gettime;
  384. BEGIN
  385.         clock:=hz200 DIV 200;
  386.         CODE(RTS);
  387. END     gettime;
  388. (*$P+ *)
  389.  
  390. PROCEDURE resetnewdisk;
  391. BEGIN
  392.         SuperExec(gettime);
  393.         timestart1:=clock;
  394.         timefortimeout1:=timestart1;
  395.         IncTime(timefortimeout1,2);
  396. END     resetnewdisk;
  397.  
  398. PROCEDURE newdisk(): BOOLEAN;
  399. BEGIN
  400.         SuperExec(gettime);
  401.         timeouttime1:=clock;
  402.         SETREG(0,timeouttime1);
  403.         CODE(0280H,0,0FFFFH);
  404.         timeouttime1:=LONGCARD(REGISTER(0));
  405.         IF timeouttime1>timefortimeout1 THEN
  406.            resetnewdisk;
  407.            RETURN TRUE;
  408.         END;
  409.         RETURN FALSE;
  410. END     newdisk;
  411.  
  412. PROCEDURE resetchannel;
  413. BEGIN
  414.         SuperExec(gettime);
  415.         timestart2:=clock;
  416.         timefortimeout2:=timestart2;
  417.         IncTime(timefortimeout2,chanwait);
  418. END     resetchannel;
  419.  
  420. PROCEDURE freechannel(): BOOLEAN;
  421. BEGIN
  422.         SuperExec(gettime);
  423.         timeouttime2:=clock;
  424.         SETREG(0,timeouttime2);
  425.         CODE(0280H,0,0FFFFH);
  426.         timeouttime2:=LONGCARD(REGISTER(0));
  427.         IF timeouttime2>timefortimeout2 THEN
  428.            resetchannel;
  429.            ChannelLock:=none;
  430.            RETURN TRUE;
  431.         END;
  432.         RETURN FALSE;
  433. END     freechannel;
  434.  
  435. PROCEDURE StartTimer;
  436. BEGIN
  437.         SuperExec(gettime);
  438.         timestart:=clock;  (* set to time in seconds *)
  439.         timer:=TRUE;
  440.         timefortimeout:=timestart;
  441.         IncTime(timefortimeout,5);
  442. END     StartTimer;
  443.  
  444. PROCEDURE IncTime(VAR t : LONGCARD; c: CARDINAL);
  445. BEGIN
  446.         IF c<1 THEN RETURN END;
  447.         t:=t+LONGCARD(c);
  448. END     IncTime;
  449.  
  450. PROCEDURE TimeOut(): BOOLEAN;
  451. BEGIN
  452.         IF (NOT timer) THEN RETURN FALSE END;
  453.         SuperExec(gettime);
  454.         timeouttime:=clock;
  455.         SETREG(0,timeouttime);
  456.         CODE(0280H,0,0FFFFH);
  457.         timeouttime:=LONGCARD(REGISTER(0));
  458.         IF timeouttime>timefortimeout THEN
  459.            StartTimer;
  460.            RETURN TRUE;
  461.         END;
  462.         RETURN FALSE;
  463. END     TimeOut;
  464. BEGIN
  465. END     TIME;
  466.  
  467. MODULE  EVENT; (* local module *)
  468. IMPORT  C,evtype,R,S,trace,framebufferfull,BConOut,Device,getf,message,
  469.         rframe,RFRAME,vblLock,FlushBuffer,framewaiting,recframesize,
  470.         rframeptr,requesttosend,cleartosend,TimeOut,frame,FrameKind,
  471.         DataKind,MediaChange,GetBPB,ADR,ADDRESS,sendtoremote,event,
  472.         ScreenPhysicalBase,TSIZE,BPB,Memdrive,RWAbs,RW,frameptr,timer,
  473.         kbdiorec,IORec,SerialDevice,statptr,GetDateTime,senddata,sendf,
  474.         gotframe,charcount,Maxdrives,gotmediach,gotbpb,SFRAME,debug,
  475.         inc,StartTimer,NETTIME,TIMESET,BEL,getfromremote,SetTime,
  476.         SetDate,OneTime,ChannelLock,channel;
  477.  
  478. EXPORT  Nwait,ToHost,HandleEvents,RESET;
  479.  
  480. VAR     nframe2                                         :       frame;
  481.         d                                               :       CARDINAL;
  482.  
  483. PROCEDURE Nwait(VAR e: evtype);
  484. VAR     i2,cksum      :       CARDINAL;
  485. BEGIN
  486.  
  487.          IF C.sendreset THEN
  488.             e:=reset;
  489.             INC(S.resets);
  490.             RETURN;
  491.          END;
  492.  
  493.          IF framebufferfull THEN
  494.          IF trace THEN BConOut(CON,"k") END;
  495.            cksum:=0;
  496.            FOR i2:=0 TO recframesize-5 DO
  497.               cksum:=cksum+CARDINAL(rframeptr^[i2])
  498.            END;
  499.            IF (cksum=rframe.cksum) THEN
  500.               getf(RFRAME);
  501.               e:=framearrival;
  502.               INC(R);
  503.         IF trace THEN BConOut(CON,"u") END;
  504.               RETURN;
  505.            ELSE
  506.               e:=nothing; (* checksum error *)
  507.               framebufferfull:=FALSE;
  508.               FlushBuffer();
  509.               INC(S.retrys);
  510.               INC(S.checksumerrors);
  511.         IF trace THEN BConOut(CON,"U") END;
  512.            END;
  513.            RETURN;
  514.          END;
  515.  
  516.          IF requesttosend AND cleartosend THEN
  517.             e:=hostready;
  518.             RETURN;
  519.          END;
  520.  
  521.          IF TimeOut() THEN
  522.             e:=timeout; 
  523.             INC(R);
  524.             INC(S.retrys);
  525.             INC(S.timeouts);
  526.          END;     (* so sorry no frame ack *)
  527. END     Nwait;
  528.  
  529. PROCEDURE ToHost(VAR f: frame);
  530. VAR     i,r                             :       INTEGER;
  531.         d                               :       CARDINAL;
  532.         bpbptr,nbpbptr                  :       frameptr;
  533.         meminfo                         :       POINTER TO message;
  534.         screen1                         :       POINTER TO ARRAY [0..255]
  535.                                                 OF CARDINAL;
  536.         ibuf,bbuf                       :       POINTER TO ARRAY
  537.                                                 [0..32] OF LONGCARD;
  538. BEGIN
  539.         IF trace THEN BConOut(CON,"H") END;
  540.         IF f.kind=callreq THEN
  541.            RETURN;
  542.         END;
  543.         IF f.kind=clearreq THEN
  544.            RETURN;
  545.         END;
  546.         IF f.kind=diag THEN
  547.            RETURN;
  548.         END;
  549.         IF f.kind=data THEN
  550.            IF f.cmd=rdmediareq THEN
  551.         IF trace THEN BConOut(CON,"M") END;
  552.               nframe2.d0:=LONGCARD(MediaChange(CARDINAL(f.d0)));
  553.               sendtoremote(data,rdmediaconf,nframe2,remote);
  554.               RETURN;
  555.            END;
  556.            IF f.cmd=rdbpbreq THEN
  557.         IF trace THEN BConOut(CON,"P") END;
  558.               nframe2.d0:=LONGCARD(GetBPB(CARDINAL(f.d0)));
  559.               bpbptr:=ADDRESS(nframe2.d0);
  560.               nbpbptr:=ADR(nframe2.info);
  561.               FOR i:=0 TO TSIZE(BPB)-1 DO
  562.                   nbpbptr^[i]:=bpbptr^[i];
  563.               END;
  564.               sendtoremote(data,rdbpbconf,nframe2,remote);
  565.               RETURN;
  566.            END;
  567.            IF f.cmd=rdrwabsreq THEN
  568.         IF trace THEN BConOut(CON,"W") END;
  569.               INC(S.rwabsreqs);
  570.               IF f.d0#Memdrive THEN
  571.                 nframe2.d0:=LONGCARD(RWAbs(RW(f.rw),ADR(f.info),1,f.recno,
  572.                                      CARDINAL(f.d0)));
  573.               END;
  574.  
  575.               IF (f.d0=Memdrive) AND (f.recno>3) THEN
  576.         IF trace THEN BConOut(CON,"V") END;
  577.                   nframe2.d0:=0;
  578.                   meminfo:=ADDRESS(LONGCARD(f.recno)*LONGCARD(512));
  579.                   IF (f.rw=0) OR (f.rw=2) THEN    (* read *)
  580.                     f.info:=meminfo^;
  581.                   ELSE
  582.                     meminfo^:=f.info;             (* write *)
  583.                   END;
  584.               END;
  585.  
  586.               IF (f.d0=Memdrive) AND (f.recno=3) THEN
  587.                   nframe2.d0:=0;
  588.                   meminfo:=ScreenPhysicalBase();
  589.                   screen1:=ADR(f.info);
  590.                   FOR i:=0 TO 63 DO
  591.                     screen1^[i]:=0;
  592.                     FOR r:=0 TO 511 DO
  593.                         screen1^[i]:=screen1^[i]+CARDINAL(meminfo^[0]);
  594.                         meminfo:=ADDRESS(LONGCARD(meminfo)+LONGCARD(1));
  595.                     END;
  596.                   END;
  597.               END;
  598.  
  599.               IF (f.d0=Memdrive) AND (f.recno=2) THEN   (* remote ikbd *)
  600.                  nframe2.d0:=0;
  601.                  kbdiorec:=IORec(Keyboard);    (* length in info[0] *)
  602.                  ibuf:=kbdiorec^.ibuf;
  603.                  bbuf:=ADR(f.info);
  604.                  kbdiorec^.ibufhd:=0;
  605.                  kbdiorec^.ibuftl:=0;
  606.                  FOR i:=1 TO INTEGER(bbuf^[0]) DO
  607.                      ibuf^[i]:=bbuf^[i];
  608.                  END;
  609.                  kbdiorec^.ibufhd:=0;
  610.                  kbdiorec^.ibuftl:=CARDINAL(bbuf^[0]*4);
  611.               END;
  612.  
  613.               IF (f.d0=Memdrive) AND (f.recno=1) THEN
  614.                  statptr:=ADR(f.info);           (* load remote stats *)
  615.                  statptr^:=S;
  616.               END;
  617.  
  618.               IF (f.rw=0) OR (f.rw=2) THEN      (* load read buffer *)
  619.                  nframe2.rw:=f.rw;
  620.                  nframe2.info:=f.info; (* if rec get buffer to send *)
  621.               END;
  622.               sendtoremote(data,rdrwabsconf,nframe2,remote);
  623.               RETURN;
  624.            END;
  625.            IF f.cmd=timereq THEN
  626.         IF trace THEN BConOut(CON,"c") END;
  627.               nframe2.d0:=GetDateTime();
  628.               sendtoremote(data,timeconf,nframe2,remote);
  629.               RETURN;
  630.            END;
  631.         END;
  632. END     ToHost;
  633.  
  634. PROCEDURE HandleEvents(VAR event: evtype);
  635. BEGIN
  636.             IF event=nothing THEN RETURN END;
  637.             IF event=hostready THEN
  638.                event:=nothing;
  639.         IF trace THEN BConOut(CON,"S") END;
  640.                vblLock:=TRUE;
  641.                senddata;
  642.                requesttosend:=FALSE;
  643.                cleartosend:=FALSE;
  644.             END;
  645.  
  646.             IF event=reset THEN
  647.                event:=nothing;
  648.         IF trace THEN BConOut(CON,"I") END;
  649.                RESET;
  650.                SFRAME.kind:=resetreq;
  651.                senddata;
  652.                IF NETTIME AND (NOT TIMESET) THEN
  653.                 NetTime;
  654.                 TIMESET:=TRUE;
  655.                END;
  656.             END;
  657.  
  658.             IF event=framearrival THEN
  659.                event:=nothing;
  660.         IF trace THEN BConOut(CON,"F") END;
  661.  
  662.                IF (RFRAME.ack=C.nextframetosend) OR debug THEN
  663.         IF trace THEN BConOut(CON,"K") END;
  664.                   cleartosend:=TRUE;
  665.                   StartTimer;
  666.                   R:=0;
  667.                   timer:=FALSE;
  668.                   inc(C.nextframetosend);
  669.                END;
  670.  
  671.                IF (RFRAME.seq=C.frameexpected) OR debug THEN
  672.                   event:=nothing;
  673.         IF trace THEN BConOut(CON,"E") END;
  674.                   IF RFRAME.kind#ack THEN (* try to exec command *)
  675.                      inc(C.frameexpected); 
  676.                      framewaiting:=TRUE;
  677.                      R:=0;
  678.                      framebufferfull:=FALSE;
  679.                      ToHost(RFRAME);
  680.                   END;
  681.                END;
  682.                IF RFRAME.kind=resetreq THEN
  683.                   event:=nothing;
  684.         IF trace THEN BConOut(CON,"*") END;
  685.                   RESET;
  686.                   BConOut(CON,BEL);
  687.                END;
  688.             event:=nothing;
  689.             END;
  690.  
  691.         IF event=timeout THEN
  692.            event:=nothing;
  693.         IF trace THEN BConOut(CON,"R") END;
  694.            sendf(SFRAME);
  695.         END;
  696. END     HandleEvents;
  697.  
  698. PROCEDURE       NetTime;
  699. VAR     nettime                         :       ARRAY [0..1] OF CARDINAL;
  700.         timeptr                         :       POINTER TO LONGCARD;
  701.  
  702. BEGIN
  703.      OneTime:=TRUE;
  704.      IF getfromremote(timereq,timeconf,nframe2,local) THEN
  705.         IF trace THEN BConOut(CON,"#") END;
  706.         timeptr:=ADR(nettime[0]);
  707.         timeptr^:=nframe2.d0;
  708.         SetTime(nettime[1]);
  709.         SetDate(nettime[0]);
  710.      ELSE
  711.         BConOut(CON,BEL);
  712.         event:=reset;
  713.      END;
  714.      OneTime:=FALSE;
  715. END     NetTime;
  716.  
  717. PROCEDURE       RESET;
  718. BEGIN
  719.         charcount:=0;
  720.         R:=0;
  721.         gotframe:=FALSE;
  722.         framebufferfull:=FALSE;
  723.         C.nextframetosend:=0;
  724.         C.frameexpected:=0;
  725.         FOR d:=0 TO Maxdrives DO
  726.             gotmediach[d]:=FALSE;
  727.             gotbpb[d]:=FALSE;
  728.         END;
  729.         cleartosend:=TRUE;
  730.         requesttosend:=FALSE;
  731.         framewaiting:=FALSE;
  732.         timer:=FALSE;
  733.         C.sendreset:=FALSE;
  734.         C.networkactive:=TRUE;
  735.         vblLock:=FALSE;
  736.         ChannelLock:=none;
  737. END             RESET;
  738.  
  739. BEGIN
  740. END     EVENT; (* local module *)
  741.  
  742.  
  743. (* ----------------------------------------------------------------------- *)
  744.  
  745. PROCEDURE Initialise (port: Device) : BOOLEAN ;
  746. (* returns TRUE if NETWORK is to be installed *)
  747. BEGIN
  748.   CODE(3f3cH,0017H,4e4eH,548fH);           (* gettime *)
  749.   CODE(2f00H,3f3cH,0016H,4e4eH,5c8fH);     (* settime *)
  750.   IF NOT installed THEN
  751.     SuperExec(PROC(setcontrol));  (* set address of global control record *)
  752.   END;
  753.   IF port=HSS THEN
  754.     rbptr:=IORec(MIDI);
  755.   ELSE
  756.     rbptr:=IORec(RS232);
  757.   END;
  758.   rbptr^.ibuf:=ADR(rbuffer);
  759.   rbptr^.ibufsize:=2048;
  760.   rbptr^.ibufhd:=0;
  761.   rbptr^.ibuftl:=0;
  762.   C.magic:=MAGIC;
  763.   C.remotedrive:=0;
  764.   framesize:=TSIZE(frame);
  765.   recframesize:=framesize;
  766.   sndframesize:=framesize;
  767.   R:=0;
  768.   RETURN TRUE;
  769. END Initialise ;
  770.  
  771. (* The following compiler directive stops the compiler from generating the
  772.    normal Modula-2 entry/exit code for the next procedure. This is needed as
  773.    this routine is called in supervisor mode by the BIOS function to install
  774.    the BIOS vectors. *)
  775. (*$P- Stop entry/exit code for next procedure *)
  776. PROCEDURE InstallVectors ;
  777. BEGIN
  778.   (* First save the current hard disk vectors *)
  779.   SaveHDBPB := CBPBProc(HDBPB) ;
  780.   SaveHDRWAbs := CRWAbsProc(HDRWAbs) ;
  781.   SaveHDMediaCh := CMediaChProc(HDMediaCh) ;
  782.   SaveCritic := PROC(EvtCritic);
  783.   (* Now set the BIOS vectors to our routines *)
  784.   HDBPB := ADDRESS(RDBPB) ;
  785.   HDRWAbs := ADDRESS(RDRWAbs) ;
  786.   HDMediaCh := ADDRESS(RDMediaCh) ;
  787.   EvtCritic := ADDRESS(NetCritic);
  788.  
  789.   drvnr:=2; (* start from drive C *)
  790.   WHILE drvnr IN DriveBits DO
  791.         INC(drvnr);
  792.   END; (* while *)
  793.   INC(drvnr); (* start of network drives *)
  794.   R := 0; (* remote = A *)
  795.  
  796.   GetOpt;
  797.  
  798.   Open("MX2NET.INF",0,handle);
  799.   IF handle>0 THEN
  800.     count:=128;
  801.     GEMDOS.Read(handle,count,ADR(NetInfo));
  802.     OK:=Close(handle);
  803.   ELSE
  804.     count:=0;
  805.   END;
  806.   OK:=FALSE; (* set to READONLY *)
  807.  
  808.   IF count>0 THEN
  809.     FOR d := 0 TO CARDINAL(count) BY 4 DO
  810.       IF d<CARDINAL(count) THEN
  811.         R := CARDINAL(BITSET(NetInfo[0+d]) * BITSET(31) )-1;
  812.         drvnr := CARDINAL(BITSET(NetInfo[1+d]) * BITSET(31) )-1;
  813.         IF (R>Maxdrives) OR (drvnr>Maxdrives) THEN R:=0; drvnr:=0; END;
  814.         IF (NetInfo[2+d]='W') OR (NetInfo[2+d]='w') THEN
  815.           OK := TRUE;
  816.         ELSE
  817.           OK := FALSE;
  818.         END;
  819.         NetMap[drvnr].Remote := R;
  820.         NetMap[drvnr].Local  := drvnr;
  821.         NetMap[drvnr].Write  := OK;
  822.         IF ((NOT (drvnr IN DriveBits)) OR NETMASK) AND (drvnr>1) THEN
  823.           INCL(DriveBits,NetMap[drvnr].Local);
  824.           INCL(NetBits,  NetMap[drvnr].Local);
  825.         END;
  826.       END;
  827.     END;
  828.   END;
  829.   R:=0;
  830.   d:=0;
  831.  
  832.   networkconnect := FALSE;
  833.   gotframe := FALSE;
  834.   framebufferfull := FALSE;
  835.   charcount:=0;
  836.   SIZEframe:=TSIZE(frame);
  837.   SIZEframecmd:=TSIZE(framecmd);
  838.  
  839.   rframeptr := ADR(rframe);
  840.   framecmdptr:=ADR(rframe);
  841.   CODE(RTS) ;                (* code to return to calling BIOS function *)
  842. END InstallVectors ;
  843. (*$P+ *)
  844.  
  845. PROCEDURE       GetOpt;
  846. VAR     d       :       CARDINAL;
  847. BEGIN
  848.   Open("MX2NET.OPT",0,handle);
  849.   IF handle>0 THEN
  850.     count:=128;
  851.     GEMDOS.Read(handle,count,ADR(NetInfo));
  852.     OK:=Close(handle);
  853.   ELSE
  854.     count:=0;
  855.   END;
  856.   NETTIME:=FALSE;
  857.   NETMASK:=FALSE;
  858.   MEMMASK:=FALSE;
  859.   PHYSLOW:=FALSE;
  860.   IF count>0 THEN
  861.     FOR d:=0 TO CARDINAL(count) DO
  862.  
  863.       IF NetInfo[d]='t' THEN (* get gemdos time *)
  864.          NETTIME:=TRUE;
  865.       END;
  866.  
  867.       IF NetInfo[d]='o' THEN (* over-write existing drive map *)
  868.          NETMASK:=TRUE;
  869.       END;
  870.  
  871.       IF NetInfo[d]='m' THEN (* memory reads-write useing rwabs *)
  872.          MEMMASK:=TRUE;
  873.          NetMap[Memdrive].Remote := Memdrive;
  874.          NetMap[Memdrive].Local  := Memdrive;
  875.          NetMap[Memdrive].Write  := TRUE;
  876.          INCL(NetBits,  Memdrive);
  877.       END;
  878.  
  879.       IF NetInfo[d]='5' THEN (* remote is 520 ST, use low ram screen *)
  880.          PHYSLOW:=TRUE;
  881.       END;
  882.  
  883.     END;
  884.   END;
  885. END     GetOpt;
  886.  
  887. (*$P- *) (* set vector to control record *)
  888. PROCEDURE setcontrol;
  889. BEGIN
  890.         IF Mptr#MAGIC THEN
  891.            C.drivemap:=DriveMap();
  892.            Dptr:=C.drivemap;
  893.         END;
  894.         C.drivemap:=Dptr;
  895.         Mptr:=MAGIC;
  896.         CODE(RTS);
  897. END     setcontrol;
  898. (*$P+ *)
  899.  
  900. PROCEDURE FlushBuffer();
  901. BEGIN
  902.   rbptr^.ibufhd:=0;
  903.   rbptr^.ibuftl:=0;
  904. END     FlushBuffer;
  905.  
  906. PROCEDURE nrecframe; 
  907. BEGIN
  908.         vblLock:=TRUE;
  909.         IF C.networkactive THEN
  910.            WHILE (BConStat(netdevice)) AND (NOT framebufferfull) DO
  911.                  recchar := BConIn(netdevice);
  912.                  IF (NOT gotframe) AND (CHAR(recchar)=SYN) THEN
  913.                     gotframe:=TRUE; (* got sync char from data *)
  914.                     charcount:=0;
  915.                  END;
  916.                  IF (charcount=1) AND ((CHAR(recchar)#STX)
  917.                     AND (CHAR(recchar)#SOH)) THEN
  918.                     gotframe:=FALSE; (* false start try again *)
  919.                     charcount:=0;
  920.                  END;
  921.                  IF (charcount=1) AND (CHAR(recchar)=STX) THEN
  922.                     recframesize:=SIZEframe;
  923.                  END;
  924.                  IF (charcount=1) AND (CHAR(recchar)=SOH) THEN
  925.                     recframesize:=SIZEframecmd;
  926.                  END;
  927.                  IF gotframe THEN                  (* put data in buffer *)
  928.                     rframeptr^[charcount]:=BYTE(recchar);
  929.                     INC(charcount);
  930.                     IF charcount=recframesize THEN (* got full frame *)
  931.                        gotframe := FALSE;
  932.         IF trace THEN BConOut(CON,"^") END;
  933.                        IF recframesize=SIZEframecmd THEN
  934.                           rframe.cksum:=framecmdptr^.cksum;
  935.                        END;
  936.                        framebufferfull := TRUE;
  937.                        RETURN;
  938.                     END;
  939.                  END;
  940.            END; (* WHILE *)
  941.         END;
  942. END     nrecframe;
  943.  
  944. PROCEDURE getf(VAR f: frame);
  945. BEGIN
  946.         INC(S.inpackets);
  947.         f:=rframe;
  948.         framebufferfull:=FALSE;
  949. END     getf;
  950.  
  951. PROCEDURE senddata;
  952. BEGIN
  953.     vblLock:=TRUE;
  954.     SFRAME.seq:=C.nextframetosend;
  955.     SFRAME.ack:=1-C.frameexpected;
  956.     sendf(SFRAME);
  957.     IF (SFRAME.kind#ack) AND (SFRAME.kind#resetreq) THEN
  958.        StartTimer; (* set timer to wait for frame ack from remote host *)
  959.     END;
  960. END     senddata;
  961.  
  962. PROCEDURE sendf(VAR f: frame);
  963. BEGIN
  964.         vblLock:=TRUE;
  965.         INC(S.outpackets);
  966.         sframeptr := ADR(sframe);
  967.         sframe:=f;
  968.         sframe.cksum:=0;
  969.         IF ((sframe.cmd=rdrwabsconf) AND ((sframe.rw=0)
  970.         OR (sframe.rw=2))) OR ((sframe.cmd=rdrwabsreq)
  971.         AND ((sframe.rw=1) OR (sframe.rw=3))) THEN
  972.            sndframesize:=SIZEframe;
  973.            sframe.syn :=  SYN ;
  974.            sframe.stx :=  STX ;
  975.            shortframe:=FALSE;
  976.         IF trace THEN BConOut(CON,":") END;
  977.         ELSE
  978.            sndframesize:=SIZEframecmd;
  979.            sframe.syn := SYN ;
  980.            sframe.stx := SOH ;
  981.            sframecmdptr:=ADR(sframe);
  982.            shortframe:=TRUE;
  983.         IF trace THEN BConOut(CON,".") END;
  984.         END;
  985.         FOR i1:=0 TO sndframesize-5 DO (* compute checksum *)
  986.             sframe.cksum:=sframe.cksum+CARDINAL(sframeptr^[i1])
  987.         END;
  988.         IF shortframe THEN sframecmdptr^.cksum:=sframe.cksum END;
  989.         FOR i1:=0 TO sndframesize-1 DO (* send frame *)
  990.             BConOut(netdevice,CHAR(sframeptr^[i1]));
  991.         END;
  992. END     sendf;
  993.  
  994. PROCEDURE waitcts(what: BOOLEAN); (* wait for cleartosend state *)
  995. BEGIN
  996.         IF what THEN
  997.            IF trace THEN BConOut(CON,"+") END;
  998.            IF OneTime THEN R:=retry END;
  999.            REPEAT
  1000.              nrecframe;
  1001.              Nwait(event);
  1002.              HandleEvents(event);
  1003.              IF R>retry THEN
  1004.                 networkerror:=TRUE;
  1005.                 RETURN; (* trouble *)
  1006.              END;
  1007.            UNTIL cleartosend;
  1008.         ELSE
  1009.            IF trace THEN BConOut(CON,"-") END;
  1010.            Nwait(event);
  1011.            HandleEvents(event);
  1012.         END;
  1013.         IF trace THEN BConOut(CON,"N") END;
  1014. END     waitcts;
  1015.  
  1016. PROCEDURE       WaitChannel(chan: channel);
  1017. BEGIN
  1018.         IF trace AND (chan=local) THEN BConOut(CON,"<") END;
  1019.         IF trace AND (chan=remote) THEN BConOut(CON,">") END;
  1020.         IF trace AND (chan=none) THEN BConOut(CON,"|") END;
  1021.         IF (ChannelLock=none) OR (ChannelLock=chan) THEN
  1022.           ChannelLock:=chan;
  1023.           resetchannel;
  1024.           RETURN;
  1025.         END;
  1026.         IF trace THEN BConOut(CON,"!") END;
  1027.         REPEAT
  1028.           nrecframe;
  1029.           Nwait(event);
  1030.           HandleEvents(event);
  1031.         UNTIL freechannel();
  1032.         ChannelLock:=chan;
  1033. END     WaitChannel;
  1034.  
  1035. (* request for data from remote hosts disk drives and system *)
  1036. (* what wanted in command, the correct reply in reply, data in f *)
  1037. PROCEDURE getfromremote(command, reply: DataKind; VAR f: frame;
  1038.                         chan: channel): BOOLEAN;
  1039. VAR     ticks   :       CARDINAL;
  1040. BEGIN
  1041.         IF (NOT C.networkactive) THEN RETURN FALSE END; (* error *)
  1042.         WaitChannel(chan);
  1043.         vblLock:=TRUE;
  1044.         networkerror:=FALSE;
  1045.         R:=0;
  1046.         StartTimer;
  1047.         IF trace THEN BConOut(CON,"A") END;
  1048.         f.kind:=data;
  1049.         f.cmd:=command;
  1050.         waitcts(TRUE);
  1051.         IF networkerror THEN
  1052.           vblLock:=FALSE;
  1053.           RETURN FALSE;
  1054.         END;
  1055.         IF trace THEN BConOut(CON,"B") END;
  1056.         SFRAME:=f;
  1057.         framewaiting:=FALSE;
  1058.         requesttosend:=TRUE;
  1059.         waitcts(FALSE);
  1060.         REPEAT
  1061.         UNTIL (NOT requesttosend);
  1062.         IF networkerror THEN
  1063.           vblLock:=FALSE;
  1064.           RETURN FALSE;
  1065.         END;
  1066.         IF trace THEN BConOut(CON,"C") END;
  1067.         ticks:=0;
  1068.         IF OneTime THEN R:=retry END;
  1069.         REPEAT
  1070.           INC(ticks);
  1071.           nrecframe;
  1072.           Nwait(event);
  1073.           HandleEvents(event);
  1074.           IF ticks>64000 THEN networkerror := TRUE END;
  1075.           IF R>retry THEN networkerror:=TRUE END;
  1076.           IF networkerror THEN
  1077.             vblLock:=FALSE;
  1078.             RETURN FALSE;
  1079.           END;
  1080.         UNTIL framewaiting AND (RFRAME.cmd=reply);
  1081.         IF trace THEN BConOut(CON,"D") END;
  1082.         f:=RFRAME;
  1083.         f.rw:=5;
  1084.         f.kind:=ack;
  1085.         f.cmd:=reply;
  1086.         sendf(f);       (* send ack for reply *)
  1087.         IF networkerror THEN
  1088.           vblLock:=FALSE;
  1089.           RETURN FALSE;
  1090.         END;
  1091.         IF trace THEN BConOut(CON,"Z") END;
  1092.         vblLock:=FALSE;
  1093.         RETURN TRUE;
  1094. END     getfromremote;
  1095.  
  1096. PROCEDURE sendtoremote(type: FrameKind; command: DataKind;VAR f: frame;
  1097.                        chan: channel);
  1098. BEGIN
  1099.         WaitChannel(chan);
  1100.         vblLock:=TRUE;
  1101.         IF trace THEN BConOut(CON,"T") END;
  1102.         f.kind:=type;
  1103.         f.cmd:=command;
  1104.         IF debug THEN cleartosend:=TRUE END; (* so we can send in loop *)
  1105.         waitcts(TRUE);
  1106.         IF trace THEN BConOut(CON,"1") END;
  1107.         SFRAME:=f;
  1108.         requesttosend:=TRUE;
  1109.         waitcts(FALSE);
  1110.         IF trace THEN BConOut(CON,"2") END;
  1111.         IF SFRAME.kind=ack THEN cleartosend:=TRUE END;
  1112.         vblLock:=FALSE;
  1113. END     sendtoremote;
  1114.  
  1115. (*$P- *)
  1116. PROCEDURE NetCritic;
  1117. BEGIN
  1118.         CODE(RTS);
  1119. END     NetCritic;
  1120. (*$P+ *)
  1121.  
  1122. PROCEDURE       recframe;
  1123. BEGIN
  1124.         EvtCritic := ADDRESS(NetCritic);
  1125.         IF (NOT vblLock) AND (NOT rwabsLock) THEN
  1126.           vblLock:=TRUE;
  1127.           nrecframe;
  1128.           Nwait(event);
  1129.           HandleEvents(event);
  1130.           vblLock:=FALSE;
  1131.         END;
  1132. END     recframe;
  1133.  
  1134. PROCEDURE       NoCritrecframe;
  1135. BEGIN
  1136.         IF (NOT vblLock) AND (NOT rwabsLock) THEN
  1137.           vblLock:=TRUE;
  1138.           nrecframe;
  1139.           Nwait(event);
  1140.           HandleEvents(event);
  1141.           vblLock:=FALSE;
  1142.         END;
  1143. END     NoCritrecframe;
  1144.  
  1145. PROCEDURE       initnetwork(port: Device);
  1146. VAR     d       :       CARDINAL;
  1147. BEGIN
  1148.   netdevice:=port;
  1149.   IF Initialise(port) THEN
  1150.  
  1151.     RESET;
  1152.     rwabsLock:=FALSE;
  1153.     IF NOT installed THEN
  1154.       SuperExec(PROC(InstallVectors)) ; (* install the NETWORK *)
  1155.       installed:=TRUE;
  1156.     END;
  1157.     event:=reset;
  1158.   END ;
  1159. END   initnetwork;
  1160.  
  1161. PROCEDURE       networkoff;
  1162. BEGIN
  1163.     C.networkactive:=FALSE;
  1164. END     networkoff;
  1165.  
  1166. PROCEDURE       networkon;
  1167. BEGIN
  1168.     C.networkactive:=TRUE;
  1169. END     networkon;
  1170.  
  1171. BEGIN
  1172.   BConOut(CON,ESC);
  1173.   BConOut(CON,'E');
  1174.   GEMDOS.ConWS(TITLE);
  1175.   BConOut(CON,CR);
  1176.   BConOut(CON,LF);
  1177. END NETWORK.
  1178.